A ppendix A 
Software Modules 

Number of 
Module Title Pages 

About 1 P a g e 

ImageDisplay 3 pages 

RefDisplay 4 pages 

SampleLocator 4 pages 

Sdimain 8 pages 

ShadeData 8 pages 

SplashScreen 3 pages 

ToothObject 6 pages 



unit About; 
interface 

uses Windows, Classes, Graphics, Forxas, Controls, StdCtrls, 
Buttons, ExtCtrls; 

type 

TAboutBox - class (TForm) 
Panell: TPanel; 
OKButton : TButton; 
Programlcon: TImage; 
ProductName: TLabel; 
Version: TLabel; 
Copyright: TLabel; 
Comments: TLabel; 

private . 

{ Private declarations } 

public 

( Public declarations ) 

end; 



var 



AboutBox: TAboutBox; 
implementation 
{$R * . DFM} 
end. 
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unit ImageDisplay; 
interface 

"Tindows, Messages, SysOtils, Classes, Graphics, Controls, For^s, Dialogs, 
TMultiP, ExtCtrls; 

type 

TfrmlmageDisplay = class (TForm) 
r== pnllmage: TPanel; 
X pmilmage: TPMultilmage; 
* procedure FormCreate (Sender : ^hject); 
£ procedure pmilmagePaint (Sender : TOb D ect) , 

:L! private 

^ { Private declarations } 

;P RefA : TRect; 

^ RefR : integer; 

ilJi RefC : integer; 

h SampleA : TRect; 

rp SampleR : integer; 

SampleC : integer; 

J* 'tSiSS"ri^Sn?i. , TRect; Colu»„s . inW» 

;S; procedure DrawGrids; 

;^! ! public 

^ { Public declarations } 

procedure Def ineGrids (Ref Area : TRect; 

RefRows : integer; 
RefCols : integer; 
SampleArea : TRect; 
SampleRows : integer; 
SampleCols : integer) ; 

procedure HideGrid; 
end; 



var 



frmlmageDisplay: TfrmlmageDisplay; 
implementation 
($R * . DFM} 

procedure Tfr.InvageDisplay.DrawGridtArea : TRect; Rows, Columns -. integer,; 
var 

Spacing : real; 
index : integer; 
ScaleX : real; 
ScaleY : real; 

Left, Right, Top, Bottom : integer; 
begin 

ScaleX := pmilmage. Width/640; 
ScaleY := pmilmage . Height/480; 
Left := Round (Area. Left * ScaleX) ; 
Right := Round (Area. Right * ScaleX); 
Top := Round (Area. Top * ScaleY); 
Bottom := Round (Area . Bottom * ScaleY); 
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with pmi Image. Canvas do 

begin 

moveto(Left, Top) ; 
lineto(Left, Bottom); 
lineto (Right, Bottom); 
lineto (Right, Top); 
lineto (Left, Top); 

if Rows > 1 then 

begin . ^ 

Spacing := (Bottom - Top) / Rows; 

for index := 1 to Rows - 1 do 

be m oveto(Left + l, Top + trunc facing V 

lineto (Right-l, Top + trunc (Spacing index)), 

end; 
end; 

if Columns > 1 then 

Spacing := (Right - left) / Columns; 
for index := 1 to Columns - 1 do 

be moJeto(Left + trunc (Spacing * index), Top+1) ; 
Uneto(Left + trunc (Spacing * index), Bottom-1) ; 

end; 
end; 
end; 

end; // DrawGrid 

procedure Tf rmlmageDisplay . DrawGrids ; 
be91 SetROP2 (pmilmage. Canvas. Handle, R2_N0T) ; 

if DisplayGrid then 
begin 

DrawGrid (Ref A, RefR, RefC) ; 
DrawGrid (SampleA, SampleR, SampleC) ; 

end; 

end; // DrawGrids 

procedure Tf rmlmageDisplay . FormCreate (Sender : TObject) ; 
begin 

DisplayGrid := false; 
end; 

procedure Tfnnln^eDispl.y^efineGrids <>£».. 

RefCols : integer; 
SampleArea : TRect; 
SampleRows : integer; 
SampleCols : integer) 

begin 

Ref A := Ref Area; 
RefR := Ref Rows; 
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RefC :« Re f Cols; 
SampleA SampleArea; 
SampleR := SampleRows; 
SampleC := SampleCols; 
DisplayGrid := true; 
pmilmage . Repaint; 
end; 

procedure Tf rmlmageDisplay . HideGr id; 
begin 

DisplayGrid := false; 
Repaint; 
end; 

procedure Tf rmlmageDisplay .pmilmagePaint (Sender : TObj 

begin 

DrawGrids; 
end; 

end. 
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unit RefDisplay; 



interface 
uses 

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dxalogs, 
Grids, ShadeData, ComCtrls, StdCtrls, ExtCtrls; 

type 

TfrmReferenceDisplay - class (TForm) 
Panell: TPanel; 
sgAnalysis: TStringGrid; 
j Panel2: TPanel; 

edGridCol: TEdit; 
udGridCol: TUpDown; 
edGridRow: TEdit; 
udGridRow: TUpDown; 
Labell: TLabel; 
Label2: TLabel; 
Label3: TLabel; 

procedure FormCreate (Sender : TObject); 

procedure InsertShadeData (Shade : TShadeColours) ; 

procedure edGridColChange (Sender : TObject); 
I procedure LoadShades (Shades : TShadeRef erences) ; . 

procedure edGridRowChange (Sender : TObject) ; 
private 

( Private declarations } 

Rowlnsertlndex : integer; 

DisplayRow : integer; 

DisplayColumn : integer; 

DisplayShades : TShadeRef erences; 

procedure ShowShades; 
public 

( Public declarations } 
end; 

var 

frmReferenceDisplay: TfrmReferenceDisplay; 

implementation 

($R * . DFM) 

const 

TitleRow = 0; 
NameColumn =0; 
RedColumn = NameColumn + 1; 
GreenColumn = RedColumn + 1; 
BlueColumn = GreenColumn +1; 
VariationColumn « BlueColumn + 1; 
RedMaxColumn = VariationColumn + 1; 
RedMinColumn = RedMaxColumn + 1; 
GreenMaxColumn « RedMinColumn + 1; 
GreenMinColumn « GreenMaxColumn + 1; 
BlueMaxColumn = GreenMinColumn + 1; 
BlueMinColumn = BlueMaxColumn + 1; 
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/ 




Precision = 6; 
Digits = 4; 

procedure TfrmRef erenceDisplay . FormCreate (Sender : TObject); 
begin 

{ Configure the Grid to Display the Reference Set } 
DisplayColumn := GridWidth div 2; 
DisplayRow := GridHeight div 2; 

udGridCol.Min := 1; 
q udGridCol.Max GridWidth; 

-*£ ! 

udGridRow.Min := 1; 
j?T udGridRow.Max := GridHeight; 

^ udGridRow. Position := DisplayRow; 

udGridCol . Position := DisplayColumn; 

5|J I 

edGridCol.Text := IntToStr ( DisplayColumn) ; 
* edGridRow.Text := IntToStr (DisplayRow) ; 

sgAnalysis fc .ColCount := 11; 
g 3 'i sgAnalysis . RowCount := 17; // may change 

■5! Rowlnsert Index := TitleRow + 1; 

sgAnalysis .Cells [NameColumn, TitleRow] := 'Shade'; 
sgAnalysis. Cells [RedColumn, TitleRow] := 'Red 1 ; 
sgAnalysis. Cells [GreenColumn, TitleRow] := 'Green' ; 
sgAnalysis. Cells [BlueColumn f TitleRow] := 'Blue'; 
sgAnalysis. Cells [VariationColumn, TitleRow] := 'Variation'; 
sgAnalysis. Cells [RedMaxColumn, TitleRow] := 'Max Red'; 
sgAnalysis. Cells [GreenMaxColumn, TitleRow] := 'Max Green' ; 
sgAnalysis. Cells [BlueMaxColumn, TitleRow] := 'Max Blue 1 ; 
sgAnalysis. Cells [RedMinColumn, TitleRow] := 'Min Red'; 
sgAnalysis. Cells [GreenMinColumn, TitleRow] := 'Min Green'; 
sgAnalysis. Cells [BlueMinColumn, TitleRow] 'Min Blue'; 

DisplayShades := TShadeRef erences . Create; 
end; 

procedure TfrmRef erenceDisplay . InsertShadeData (Shade : TShadeColours) ; 
var 

Variation : real; 
begin 

with Shade. GridColours [DisplayColumn, DisplayRow] do 
begin 

sgAnalysis .Cells [NameColumn, Rowlnsertlndex] := Shade. Name; 
sgAnalysis. Cells [RedColumn, Rowlnsertlndex] := FloatToStrF (Red, ffFixed, 
Precision, Digits); 

sgAnalysis. Cells [GreenColumn, Rowlnsertlndex] := FloatToStrF (Green, ffFixed, 

Precision, Digits) ; 

sgAnalysis. Cells [BlueColumn, Rowlnsertlndex] := FloatToStrF (Blue, ffFixed, 

Precision, Digits); 

sgAnalysis . Cells [RedMaxColumn, Rowlnsertlndex] : » FloatToStrF (RedMax, 
ffFixed, Precision, Digits); 
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sgAnalysis. Cells [GreenMaxColumn, Rowlnsertlndex] := FloatToStrF<GreenMax, 
"^^arsi-CeJlslBfueSixColu^, RowXnsertlndex] := FloatToStrF(Blue M ax, . 
ffFi :^aIy;is S c:^s[R!dM S iicolu m n, Rowlnsertlndex] := FloatToStrF (RedMin, 
"'i^airsi-C^is^eenMinColu.n, Rowlnsertlndex] := FloatToStrF (GreenMin, 
""^^alyK-C^is^BfueSinColun.n, Rowlnsertlndex] := FloatToStrF (BlueMin, 
^ ££Fi ;Si.Sn i U°^S2i t - > i.dMin) ♦ (GreenMax - GreenMin, ♦ (BlueMax - 
1 ^^sSnalysis. Cells [VariationColumn, Rowlnsertlndex] := FloatToStrF (Variation, 
ff Fixed, Precision, Digits); 

^ end; 

inc (Rowlnsertlndex) ; 

fQ end; 

li fi 

{H procedure Tf rmRef erenceDisplay . ShowShades; 

is var 

Shadelndex : integer; 
^1 CurrentShade : TShadeColours ; 
-.; ~'\ begin . 

™ Rowlnsertlndex := TitleRow +1; . ^ rnn -^ _ i do 

g for shadelndex := 0 to DisplayShades . ShadeList .Count 1 do 

IK CurrentShade := DisplayShades . ShadeList . Items [Shadelndex] ; 
InsertShadeData (CurrentShade) ; 
end; 
end; 

procedure TfrmReferenceDisplay.LoadShades (Shades : TShadeRef erences) ; 

var 

IDisplayRow : integer; 
begin 

( First Clear Old list } 

if DisplayShades. ShadeList. Count > 0 then 

for IDisplayRow := 1 to DisplayShades . ShadeList . Count do 
sgAnalysis.Rows [IDisplayRow] .Clear; 

//DisplayShades . Free; 
DisplayShades := Shades; 

sgAnalysis.RowCount := Shades . ShadeList . Count + 1, 
ShowShades; 
end; 

procedure Tf rmRef erenceDisplay. edGridColChange (Sender: TObject) ; 

begin 

if Visible then 
begin 

DisplayColumn : = StrToInt (edGndCol .Text) ; 
ShowShades; 
end; 
end; 

procedure Tf rmReferenceDisplay.edGridRowChange(Sender: TObject) ; 
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begin 

if Visible then 

^XsplayRow := StrToInt (edGridRow. Text ) ; 

ShowShades; 
end; 
end; 

end. 
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unit SampleLocator; 



interface 
uses 

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialog 
TMultiP, ExtCtrls, StdCtrls; 



type 

TfrmSampleLocator = class (TForm) 
^ Panell: TPanel; 
U pmilmage: TPMultilmage; 

OpenDialog: TOpenDialog; 
-p btnLoadSample: TButton; 
;M: edXPos: TEdit; 
*gr; Labell: TLabel; 
p\ edYPos: TEdit; 
JJi Label2: TLabel; 
^ rgLocation: TRadioGroup; 

Panel2: TPanel; 
|L Label3: TLabel; 
*H Label4: TLabel; 

edRefX: TEdit; 
W Label5: TLabel; 
ip edRefY: TEdit; 
Cli Label6: TLabel; 

edSampleX: TEdit; 

Label7: TLabel; 

edSampleY: TEdit; 

Label8: TLabel; 

btnSave: TButton; 

btnCancel : TButton; 

procedure pmilmageMouseMove (Sender : TObject; Shift: TShiftState; X, 
Y: Integer) ; 

procedure FormCreate (Sender : TObject); 

procedure btnSaveClick (Sender : TObject); 

procedure btnLoadSampleClick (Sender : TObject); 

procedure pmilmageClick (Sender : TObject); 

procedure FormShow (Sender : TObject); 

procedure btnCancelClick (Sender : TObject); 
private 

{ Private declarations } 
public 

{ Public declarations } 

ReferenceLocation : TPoint; 

SampleLocation : TPoint; 



end; 
var 

f rmSampleLocator : TfrmSampleLocator; 
implementation 
($R * . DFM} 
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uses 

SDIMain, IniFiles; 

procedure Tf rmSampleLocator .pmilmageMouseMove (Sender : TObject; 

Shift: TShiftState; X, Y: Integer); 
begin 

edXPos.Text IntToStr(X); 
edYPos.Text := IntToStr(Y); 
end; 

C^rocedure Tf rmSampleLocator . FormCreate (Sender : TObject) ; 
iCvar 

C IniFile : TIniFile; 
(Ubegin 

iiT; { Load The Saved Sample Location From Ini File ) 

{ Set Default for now } 
ir;! ReferenceLocation :« Point (170, 40); 
||L: SampleLocation : - Point (300, 160); 

;^ if FileExists(f rmShadeAnalyzer. DiskDrive + 'AnalyseV + IniFileName) then 
jUj begin 
Nl try 

W IniFile := TIniFile . Create ( f rmShadeAnalyzer . DiskDrive + 'AnalyseV .+ 

ClniFileName) ; 

with ReferenceLocation do 
b_egin 

X StrToInt (IniFile. ReadString( IniRef erenceSection, IniRefX, 'ERROR')) 

Y := StrToInt ( IniFile . ReadString ( IniRef erenceSection, IniRef Y, 'ERROR')) 
end; 

with SampleLocation do 
begin 

X := StrToInt (IniFile. ReadString ( IniSampleSection, IniSampleX, 'ERROR')) 

Y := StrToInt (IniFile. ReadString ( IniSampleSection, IniSampleY, 'ERROR')) 

end; 
finally 

IniFile. Free- 
end; 
end; 
end; 

procedure Tf rmSampleLocator . btnSaveClick (Sender : TObject) ; 
var 

IniFile : TIniFile; 
begin 

ReferenceLocation := point (StrToInt (edRefX. Text) , StrToInt (edRefY. Text )) ; 
SampleLocation := point (StrToInt (edSampleX. Text ) , StrToInt (edSampleY . Text) ) ; 

if FileExists(f rmShadeAnalyzer. DiskDrive + 'AnalyseV + IniFileName) then 
begin 
try 

IniFile := TIniFile .Create (f rmShadeAnalyzer . DiskDrive + 'AnalyseV + 
IniFileName) ; 

with ReferenceLocation do 
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begin 

IniFile.WriteString (IniReferenceSection, IniRefX, IntToStr (X) ) ; 
IniFile.WriteString (IniRef erenceSection, IniRefY, IntToStr (Y) ) ; 
end; 

with SampleLocation do 
begin 

IniFile.WriteStringdniSampleSection, IniSampleX, IntToStr (X) ) ; 
IniFile.WriteString (IniSampleSection, IniSampleY, IntToStr (Y) ) ; 
end; 
finally 
1 IniFile. Free; 

end; 
end; 

Close; 
I end; 

I procedure Tf rmSampleLocator .btnLoadSampleClick (Sender : TObject); 
begin 

OpenDialog. Title := 'Sample Imade To Display'; 
J OpenDialog. InitialDir := Copy < ParamStr (0) , 0, 3) + • Analyse\Pictures\ ' 
; OpenDialog. DefaultExt := GraphicExtension {TBitmap) ; 

OpenDialog. Filter := GraphicFilter (TBitmap) ; 

OpenDialog. Options := [of PathMustExist , of FileMustExist ] ; 

if OpenDialog. Execute then 

begin 

pmi Image . Picture . LoadFromFile (OpenDialog . Filename ) ; 
end; 
end; 

procedure Tf rmSampleLocator .pmilmageClick (Sender : TObject) ; 
begin 

( Check Location Option and Update The Location Co Ords } 

if rgLocation. Itemlndex = 0 then 

begin 

edRefX.Text := edXPos.Text; 

edRefY.Text := edYPos.Text; 
end 
else 
begin 

edSampleX.Text := edXPos.Text; 
edSampleY.Text := edYPos.Text; 
end; 
end; 

procedure Tf rmSampleLocator . FormSho'w (Sender : TObject); 
begin 

edRefX.Text := IntToStr (Ref erenceLocation. x) ; 
edRefY.Text := IntToStr (Ref erenceLocation. y) ; 
edSampleX.Text :~ IntToStr (SampleLocation . x) ; 
edSampleY.Text := IntToStr (SampleLocation. y) ; 
end; 

procedure Tf rmSampleLocator . btnCancelClick (Sender : TObject); 
begin 
Close; 
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+ 



end; 
end. 




unit Sdimain; 



interface 




, Forms, Controls, Menus, 
xtCtrls, ComCtrls, 



ShadeData; 



const 

IniFilename 



' ShadeAnalyse . ini 1 ; 



IniReferenceSection 

IniRefX 
IniRefY 



•REFERENCE AREA' ; 
•RefAreaX' ; 
•RefAreaY' ; 



IniSampleSection 

IniSampleX 

IniSampleY 



•SAMPLE AREA' ; 
•SampleAreaX' ; 
• SampleAreaY 1 ; 



IniShadeSetSection 
IniDefaultGuide 



Startup 



Boolean 



•DEFAULT GUIDE'; 
• GuideFilename ' ; 

true; // used for splash sere 



type 



TfrmShadeAnalyzer 



= class (TForm) 



SDIAppMenu: TMainMenu; 
FileMenu: TMenuItem; 
Exitltem: TMenuItem; 
Nl: TMenuItem; 
OpenDialog: TOpenDialog; 
Helpl: TMenuItem; 
Aboutl: TMenuItem; 
StatusBar: TStatusBar; 
Calibrate: TMenuItem; 
Optionsl: TMenuItem; 
Showlmagel: TMenuItem; 
ShowReferencel: TMenuItem; 
SetSampleLocl: TMenuItem; 
Analysel: TMenuItem; 
gbShadeSet: TGroupBox; 
btnLoad: TButton; 
btnSave: TButton; 
edShadeSetName: TEdit; 
gbSampleAnalysis: TGroupBox; 
btnMatch: TButton; 
Labell: TLabel; 
edNearest: TEdit; 
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procedure btnSaveClick ( Sender: TObject); 
- ESSE %£££%^£^~ TC^e^.n, , 

procedure For^ctiv.te (Sender, TObject); 

private , 

{ Private declarations } 

sstoi ssrsis^si"-. : *— «~ : string) : 

TSh iunct?on%indNear eS tSh a de(Sa m ple : tShadeColours) : string- 
procedure LoadShadeSet (Filename : string), 



public 

{ Public declarations ) 
DiskDrive : string; 
NewCalibration : boolean; 

end; 



var 



f rmShadeAnalyzer : Tf rmShadeAnalyzer ; 

implementation 
uses 

{$R * . DFM} 
const 

RefRedMedian = 0.54 32; 
RefGreenMedian ~ 0.6308; 
Ref BlueMedian = 0.3355; 

Re f Rows = 1; 

RefColumns = 1; change see Shade Data 

SampleRows - GridHeight; // To cnang 
SampleColumns = GridWidth; 

procedure Tf rmShadeAnalyzer. ShowHint (Sender: TObject); 

^ItatusBar. SimpleText Application. Hint ; 
end; 

procedure Tf rmShadeAnalyzer .AboutlClick (Sender : TObject); 

begin 

About Box . ShowModal ; 
end; 

procedure Tf rmShadeAnalyzer . FormCreate (Sender : TObject); 
var 

IniFile : TIniFile; 
DefaultShadeFilename : string; 

begin . . 

Application.OnHint : = show ^ nt ; _ 

DiskDrive := Co PV ( ^ ara ^" ( ^late - // we will build a new list 
Shades := TShadeRef erences . Create, //we 
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NewCalibration := false; 

^TniFile •= TlniFile. Create (DiskDrive + -AnalyseV + IniFilename); 
Defa^tShadeFiiename := iniFile.ReadStringdniShadeSetSectxon, 

^^DefafltSha^Fllename'U DiskDrive + 'AnalyseV + Def aultShadeFilename; 

LoadShadeSet (Def aultShadeFilename) ; 

finally 

IniFile.Free; 

end; 

.« end; 

^function TfrmShadeAnalyzer.Analyselmage (Filename : string; ShadeName : string, 
C TShadeColours ; 

:M= var 

inn ShadeColours : TShadeColours; 

Tooth : TTooth; 
ijfj DeltaRed : real; 
5=! DeltaGreen : real; 

DeltaBlue : real; 
jL pixelPercent : real; 
;H RefArea : TRect; 
N SampleArea : TRect; 
W begin 

C Tooth := TTooth. Create; 



8* 



{ Analyse The Reference Area } 
frmlmageDisplay.HideGrid; 

Application. ProcessMessages; 

RefArea := Tooth. FillSearchSampleLimits (frmSampleLocator . R ^"" C f ° C ^ it>n) ' 
frSmageDisplay.DefineGridstRefArea, RefRows, RefColumns, Rect (0, 0, 0, 0) , 

SampleRows, SampleColumns) ; 
Application. ProcessMessages; 

Application. ProcessMessages; 

Tooth.Analyse<0, 0, RefArea, RefRows, RefColumns, DeltaRed, DeltaGreen, 
DeltaBlue, PixelPercent) ; 

DeltaRed := RefRedMedian - DeltaRed; 
DeltaGreen := Ref GreenMedian - DeltaGreen; 
DeltaBlue := Ref BlueMedian - DeltaBlue; 

{ Now Analyse the Sample Area } 
f rmlmageDisplay . HideGrid; 

Tooth. LoadBitmapFromFile(FileName) ; T«^wi- m ^- 
f rmlmageDisplay .pmilmage . Picture . Bitmap . Assign (Tooth . ToothBxtmap) , 
Application. ProcessMessages; 

i n ^ Tooi-h FillSearchSampleLimits (f rmSampleLocator .SampleLocation) ; 
SampleArea := Tooth. Fx "?* a "2~wo 0 0 0) RefRows, RefColumns, SampleArea, 
f rmlmageDisplay .Def ineGrids (Rect (0, 0, 0, 0) , Ker^ows, 

SampleRows, SampleColumns) ; 
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Application. ProcessMessages; 
Application. ProcessMessages; 

ShadeColours. Name := ShadeName; 
Result := ShadeColours; 
Tooth. Free; 
end; 

procedure Tf rmShadeAnalyzer .CalibrateClick (Sender: TObject) ; 
var 

FilePath : string; 
Filelndex : integer; 
lFilename : string; 
ShadeName : string; 
ProgressBar : TProgressBar; 
ShadeColours : TShadeColours; 

beqin , . 

Op.»Dl.lo,.Tltl. , =- -File; . T. Analyse ; xpictuc ..y , 

if OpenDialog. Execute then 
with OpenDialog. Files do 

^edShadeSetName.Text := 'New Calibration'; 

SSSiSTStSxS.™ loading Calibration Bitmaps-; 
ih a ad e e S s-:"?Shade R eferences.Create; // we will build a new list 

FilePath := ExtractFilePath (OpenDialog. FileName) ; 
ProgressBar := TProgressBar .Create (self ) ; 
ProgressBar. Parent :«= self; 
ProgressBar. Align :- alBottom; 
ProgressBar .Min := 0; 

^nsSrls^p'T. 0 !;" 1 // 2 ^. _«* t. »ov. with the StepXt method 
for Filelndex := 0 to Count - 1 do 

begin . 

lFileName := Strings [Filelndex] ; 

{ Get the Shade Name from the filename ) 

ShadeName := ExtractFilename (lFilename^; . +Sha deName; 

remove the letter 

ShadeColours := Analyselmage (lFileName, ShadeName); 

Shades. AddSample (ShadeColours) ; 
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end; 

end; 



ProgressBar.Stepit; // Move one Step amount 
end; 

Application. ProcessMessages; 
StatusBar. Simple iext - 

1 "".SSS.'ZSS ""eLrence Set- 

StatusBar. SimpleText . MU * 

Shades. ReduceList; amount 
ProgressBar .Stepxt, // «uvc 

Shades. SortList; 
ProgressBar . Free; 
StatusBar. SimpleText := 'Done'; 



p „«*o c e Tf ,„S h ,ae.n. ly ,e r .S h o„ I » a ,e 1 ClicMSe„aer, TO.Ject,.- 

begin 

f rmlmageDisplay . Show; 

r„l ti o„ III - ta d«-.l»-r.«na*.«.«— ■ — 

^CurrentShade : TShadeColours ; 
ShadeName : string; 
ShadeDifference : real; 
CurrentDif ference : real; 
Shadelndex : integer; 

ShadeDifference := 1000000; 

rr d Sh a ar ei rdex N °= e ; ; to Shades . ShadeList .Count - 1 do 

S'cS^SSS^n^ < ShadeDifference then 

ShadeName := CurrentShade Name; 

ShadeDifference := CurrentDif ference, 

end; 
end; 

result := ShadeName; 
end; 

procedure TfrmShade^alyzer.ShowReferencelClicMSender: TO bj ect, ; 

be lrmReferenceDis P lay.LoadShades(Shades); 

f rmRef erenceDisplay . ShowModal ; 
end; 
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proc e dUI e If ^,»«--— TObje " ,; 

e p "l.u« «™s h ,ae^«— — IS ^' ! T ° b,eCt,i 

var . 

ProgressBar : TProgressBar, 

^nDialog .Title := ' AnalyseNPicturesV ' ; 

OpenDialog.InitxalDir . hicExten sion (TBitmap) ; 

OpenDialog . Def aultExt . £ * x (TBitmap) ; 
C*.nDi.log.Filt« Gr-g^t^^ of meMustExlst ) ; 

OpenDialog. Opt ions . i« 
if OpenDialog. Execute then 

begin „ ,-.= ••• 

SSSSfr 'TimpleText' 'Analyzing Sample'; 

ProgressBar := TProgressBar .Create (self ) ; 
ProgressBar. Parent := 
ProgressBar. Align: = alBottom. 
ProgressBar .Min :- 0; 

ProgressBar. Max := 3; to move wit h the Steplt 

ProgressBar. Step :- 1. 

IFilename :- OpenDialog . Filename; 

ProqressBar . Steplt; 
Application. ProcessMessages; 

Samplecolours := AnalyseImage(lFile N ame, 'UnKnown'); 

ProgressBar .Steplt; 
Application . ProcessMessages; 

e- n^Text - 'Searching for Nearest Shade'; 
r/ N rre a st: S Texf S ^UearestShade (SampleColours) ; 

ProgressBar . Steplt ; 
Application. ProcessMessages ; 

StatusBar. SimpleText := 'Done'; 
ProgressBar . Free; 
end; 
end; 

Kvn^veClick (Sender: TObject) ; 
procedure TfrmShadetoalyzer.btnSaveClxcKl 

var 

IFilename : string; 
OutStream : TFileStream; 
IniFile : TIniFile; 
begin , qhafle Guide Filename to Save'; 
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SaveDialog. DefaultExt :- ' SDS /'" 
sav * r-iiter •= 'Shade Guides I *. SDS , 

SaveDialog. Filter . & PathMu stExist) ; 
SaveDialog. Options .- [orratnn 
if SaveDialog. Execute then 
with SaveDialog do 

bS !r n not FileExists (Filename) or (Extr actFilename (Filename) ]) , 

^" s ^ eDig( m :s n ^ r rtionrUve S : l**. « -««..> «»» 

begin ^ . . 

"outStream := TFileStream.Create (Filename, fmCreate or 
Shades . SaveToStream (OutStream) ; Filen ame) ; 

1File rr t H:me X T ::f = ^Filename?!, L ength(lFilename) - 4); 

edShadeSetName . Text . <~«fjr v 
NewCalibration := false; 

t-rv . , rv • A a 'analvseV + IniFilename) ; 

finally 

IniFile.Free; 

end; 

finally 

OutStream. Free; 

end; 
end; 
end; 

end; 

~ t naH<;hadeSet {Filename : string); 
procedure Tf rmShadeAnalyzer . LoadShadeSet t 



var 



InStream : TFileStream; 
IniFile : TIniFile; 
lFilename : strings- 
begin 



'Ifswf™ •-TFUcftr^lSlft^Fii^Ue. frcOpenHead or fn.Sha.reCo.pat> ; 

sber F "?Sh.de*efe r *nc«.Crea»; // « «i" »""<< * "~ 
Shades. LoadFromStream( InStream) ; 



finally 

IniFile.Free; 

end; 

finally 

InStream. Free; 

end; 
end; 



procedure TfrmShadeAnalyzer .btnLoadClicMSender: TObject), 
be ? P enDialog. Title 'Shade Guide Set to Load'; 
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OpenDialog.InitialDir := DiskDrive + 'AnalyseX ; 
OpenDialog.DefaultExt:^^^^ 

■"SSSSS'.SiiS.'- CofPathMustExist, ofFileMustExxstl; 
if OpenDialog. Execute then 

LoadShadeSet (OpenDialog. Filename) , 

end; 

procedure Tf rmShadeAnalyzer . FormClose (Sender: TObject; 
var Action: TCloseAction) ; 

begin . „ „„n, _ Check for unsaved Calibration Set } 
{ Closing Program - cnec* 

if (NewCalibration) and saved. Save Now? 1 , 

btnSaveClick(self ) ; 

end; 

procedure Tf rmShadeAnalyzer . FormActivate (Sender : TObject, ; 

begin 

if Startup then 
begin 

Startup := false; 

f rmSplashScreen . Show; 

Application. ProcessMessages; 

{ $IFDEF SLIDELOGO} , , 1000 . 

f rmSplashScreen. Timer 1. Interval 1000, 

{$EL frmS P lashScreen. Timer 1. Interval 3000; 

{ $ENDIF) 

end; 
end; 

end. 
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unit ShadeData; 

' Th e Shade reference is divide, ^J^i^^e SK«SS"« «b«. 

area in correlation matches. 

> 

interface 

uses 

Classes; 



const 

GridWidth * 10; 
GridHeight = 10; 

type 

PShadeColourElement 
TShadeColourElement 



used) 



TShadeColourElement) 
real) ; 



"TShadeColourElement ; 
class (TObject) 

Red : real48; 

Green : real48; 

Blue : real48; 

Valid : boolean; 

ValidPixelPercent 



// Average red content 
// Average green content 
// Average blue content 
// Valid for comparison 

real48; // 0..1 d = all pixels 



RedDev : 
GreenDev 
BlueDev : 
RedMax : 
RedMin : 
GreenMax 
GreenMin 
BlueMax 
BlueMin 



rea!48; 

: real48; 
real48; 

real48; 

real48; 

: real48; 

: real48; 
: real48; 
: real48; 



constructor Create; 

function ColourDifference (ShadeColour : 



real48; fry 

procedure StoreColour (R, G, B 



: real48; Percent : 
rea!48; Percent : real) 



procedure AddColour (R, G, B : 
function ValidCell : boolean; 
procedure SaveToStream (OutStream : TStream) ; 
?ro"dure LoadFromStream(InStream : TStream); 

private 
end; 



PShadeColours 
TShadeColours 



^TShadeColours; - 
class (TObject) 

Name : string; 



etc. 

TShadeColourElement ; 
rea!48; 



// Name of the Shade reference 
GridColours : array [1 . .GridWidth, 1 . .GridHeight] of 
function ColourDifference (ShadeColours : TShadeColours) 
procedure SaveToStream (OutStream : TStream); 
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TShadeReferencei 



procedure LoadFromStream(InStream : TStream) ; 
private 
end; 

class (TObject) 

ShadeList : TList; 

procedure Clear; 
procedure SortXist; 

r"cedo" E£E£Si-IO..«tt«. : 1 ; 

Procedure LoadFromStreamdnStream = TStream) 

private 
end; 



implementation 

uses 1 
SysUtils, Dialogs, Controls; 

const „ n qc. // 95% of pixels must be used 

ValidityLimit " u,y3 ' 

constructor TShadeColourElement .Create; 

begin 

Red := 0; 
Green := 0; 
Blue := 0; 

ValidPixelPercent := 0; 
Valid := false; 
RedDev :~ 0; 
GreenDev := 0; 
BlueDev := 0; 
RedMax := 0; 
RedMin := 1000; 
GreenMax := 0; 
GreenMin := 1000; 
BlueMax :» 0; 
BlueMin := 1000; 
end; 

procedure TShadeColourElement . storeColour (R» G# B : reaHS; Percent = real. 

begin 

Red := R; . 
Green := G; 
Blue := B; 

ValidPixelPercent :» Percent; 
Valid := {Percent >- ValidxtyLimxt) ; 
end; 

procedure TShadeCol urEletnent .AddColour (R,G, B , real«8; Percent : real,; 

begin _ 
if R > RedMax then RedMax := R, 
if G > GreenMax then GreenMax := G; 
if B > BlueMax then BlueMax :» B; 



^harleData - nap** 7 



if r < RedMin then RedMin : — R* 
if G < GreenMin then GreenMin G, 
if B < BlueMin then BlueMxn B, 
Red := Red + R; 
Green :«= Green + G; 
Blue := Blue + B; 
end; 

function TShadeColourElement.ValidCell : boolean; 

begin 

Result Valid; 



real48; 
var 

DistanceRed : real48; 
DistanceGreen : real48; 
DistanceBlue : real48; 



Tf" (Valid) and (ShadeColour .Valid) then 

^X^- SHadeColour . Blue) ; 
Result :- ^tC.jrCDj.t.jcj^^ + 

sqr (DistanceBlue) ) ; 

end 

else , . , nrBnare if any element is invalid 

Result := -1; // cannot compare it any 

end; 

, rlom ,„t saveToStream(OutStream : TStream) ; 
procedure TShadeColourElement .Saveios 

^OutStream.WriteBuf f er (Red, SizeOf (Red) ) ; 
OutStream. Writeoff er (Green, 
OutStream.WriteBuffer Blue, Size i 

OutStream.WriteBuf f er ^^p^nt, sizeOf (ValidPixelPercent) ) ; 
OutStream.WriteBuf f er ^^^of (RedDe v> ) ; 
OutStream.WrxteBuffer RedDev (GreenOev) ) ; 

OutStream.WrxteBuf f er GreenDe (BlueDev ) ) ; 

OutStream.WriteBuf fer £™£« v ' i2e0f (RedMa x) ) ; 
OutStream.WriteBuf fer RedMax, Size 

OutStream.WriteBuffer RedMin, Size . ? 
end; 

"ifstre^.ReadBuf fer (Red. SizeO* (Red, , , 
InStream.ReadBuf f«(Gree n , _f *!?°' B ^", .' ' 

InStream.ReadBuffer (Valia, 



R eadBuffer(ValidPixelPercent, SizeOf (ValidPixelPercent, ) ; 
InStream.ReadBuf fer jvax Qf (RedDe v) ) ; 

InStream.ReadBuf fer sizeOf (BlueDev) ) ; 

InStream.ReadBuf f er BlueDe ; 
InStream.ReadBuffer in size0 f (RedMin) ) ; 

InStream. ReadBuf f er j si2eQf (Gree nMax) ) ; 
InStream.ReadBuffer GreenMax £ 1 ^ , , 
InStream.ReadBuf f er JGreenMxn, (BlueMa x) ) ; 

Kn. SizeOf (BiueMin, ) ; 

C.ion.SKadeCo.ou.s.Co^^e.enceCSHadeCo^ . XShadeCoiours, , ~ai 

r . ri . ar ray[l..GridHidth f 1 . .GridHeight] of rea!48; 
Dif ferenceGrxd : arrayix--« 
! widthlndex : integer; 
! Heightlndex : integer; 
j MatchedCells : integer; 

i begin 

Result := 0; 
. MatchedCells :«= 0; 

, C^are each g ,id pcsi^o- ^-' ' 

,i 'Vr^nSndex 11 Crid„e ig ht do 

Heightlndex] ) ; 
end; 



{ 



CaXculate the Colour Difference for the whole Shade 

for Widthmdex :■!» « l «i*.i*t d, 

£0 If B oSer^c= G r:d 1 t wrd t G hIn d d^ 9 »eioht In dex, <> -1 then 

b t"ult =- Result ♦ Sq r(DifferenceCrid,«idthIndex. Heiohtmdex, , , 

inc (MatchedCells) ; 
ResulfU Sqrt (Result/MatchedCells) ; 
end; 

procedure TShadeColours -S,veTo S trea„(OutStrea» . TStrea*, , 
var 

Widthlndex : integer; 
Heightlndex : integer; 
StringLength : integer; 

^SringLength := L «" gth <**i nqLe ngth, SizeOf (StringLength) ) ; 
OutStream.wri teBuffer ^""^SLingLength) ; 
OutStream.WriteBuf f er (Haaejl , St rx g 

for Widthlndex :- 1 to ^^^^ do 
for Heightlndex := 1 to Grxan y 



end; 



Gri dColours [Widthlndex, Heightlndex, .SaveToStream (OutStream) ;. 



procedure TShadeColours. LoadFromStream(InStream : TStream, ; 



var 

Widthlndex : integer; 
Heightlndex : integer; 
StringLength : integer; 



^InStream.ReadBuffer (StringLength, SizeOf (StringLength, , ; 

SetLengtMName, StringLength); 
InStreL.ReadBuf f er (Name [1] , StrxngLength) . 

for Widthlndex := 1 to GrxdWidth do 
for Heightlndex := 1 to GrxdHexght do 

begin u .f«hHndexl TShadeColourElement .Create; 



end; 
end; 

procedure TShadeRe f erences. AddSample (Sample : TShadeColours,; 
begin 

ShadeList .Add (Sample) ; 
end; 

procedure TShadeRef erences .Clear; 

begin 

ShadeList .Clear; 

end; 

constructor TShadeRef erences . Create; 
begin 

ShadeList := TList .Create; 
end; 

function SortComparedteml, Item2: pointer,: Integer; 

^fTShadeColourslItemD.Name < TShadeColours (Item2, .Name then 

elSrif'T^adeColoursdtemD.Name > TShadeColours (I tem2, .Name then 

Result :« 1 
else 

Result := 0; 

end; 

procedure TShadeRef erences. SortList; 
begin 

ShadeList . Sort (SortCompare) ; 
end; 

procedure TShadeRe f erences . ReduceLis t ; 

^AverageShadeColours : TShadeColours; 
AveragedShades : TList; 
Cur rent Shade : TShadeColours; 
Shadelndex : integer; 
Row, Col : integer; 
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"t_r : 



A v«a 9 «Count = a„.y U ■ .GridWidth, ! . . GridHeioht , of inteoer; 
-fJo, each individual N a„ed shade. — ,1! vaiues into, one Shad.Coiours 

} 

// New (AverageShadeColours ) ; 
AveragedShades := TList .Create; 
/ /New (CurrentShade ) ; 

CurrentShade := TShadeColours .Create; 
CurrentShade . Name : - ' 9 • 
for Shadelndex =- 1 to sh.del.ist .Count do 

be I £ n cu,rent Sh ed..»,»e <> TShadeCoiours .ShadeList .Ite„s IShadelndex-X, , 

then 

begin 

if Shadelndex <> 1 then 

Save the last shade and start a new one > 
for Col := 1 to GridWidth do 
f^r Row •= 1 to GridHeight do 
for Row . a , Rowl <> o then 

"^t^X^esnadeCo^uL.OridCoiourMCoX. Bow,, d, 

* b T2 e ;^!1 r err^ar g ecoS' [ cr , k ^1 .. 

S^UdnJre^nrr-^aS'pSi^ceU / *ve M9 eCou„t t CoX. «.„ 

AveragedShades. Add (AverageShadeColours); 
end; 

^^gtsHadeC^ourf !- TShadeColours. Create; 
for Col := 1 to GridWidth do 
for Row := 1 to GrxdHeight do 

be AterageShadeColours.GridColours[Col,Row] : = 

TShadeColourElement . Create ; 

AverageCount[Col, Row] := u, 

end; , Mam *>. = TShadeColours (ShadeList . Items [Shadelndex- 

AverageShadeColours.Name.= Tsnaaeuoxw 

1] ) .Name; 
end; 

CurrentShade := ShadeList. Items [Shadelndex-l] ; 

for Col := 1 to GridWidth do 
for Row := 1 to GridHeight do 

be wi?h AverageShadeColours. GridColours [Col, Row) do 
be If n currentShade.GridColours[Col, Row] .Valid then 

begin 

Valid :•» true; 
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„ Red •.- «rf ♦ Cutr r^SShS GridColour. [Col. RO»l -Sreen; 

" i„c(AverageCount[Col. Row]): 

end; 
end; 
end; 

end; 

( Save the last shade } 

be «tH •- Red / AverageCount[Col, Row]; 

Green" •= Green / AverageCount t Col. Row] ; 

end; 

AveragedShades.Add(AverageShadeColours) ; 



ShadeList.Free; 

ShadeList := AveragedShades. 

end; 



procedure TS ha d e Re £ ere„ces. S - T oS t -» ( Ou t S"ea» , 
var 

Shadelndex : integer; 
CurrentShade : TShadeColours; 
begin j . ... // First write the number of Shade xn the set 

Shadelndex := shadeLl ^; C °^ e / sizeOf (Shadelndex) ) s 
OutStream.WriteBuffer (Shadelndex SxzeOM 

for Shadelndex := 0 to ShadeLxst. Count 
CurrentShade :- ShadeList. I terns ^Sha^delndex] ; 
CurrentShade . SaveToStream(OutStreanr) . 

end; 
end; 

procedure TS-adeRaf.rencss. W .dr I( »s t rea»<InS«ea m , TS t rea», ; 
var 

NumberOfShades : integer; 
Shadelndex : integer; 
CurrentShade : TShadeColours; 

be ?nStrea m .ReadBuffer (-^fShad si.eOf^erOf Shades) ) , 
for Shadelndex := 0 to NumberOfShades 
CurrentShade := TShadeColours. Create; 
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Current Shade . LoadFromS t ream ( InS t ream) ; 
AddSample (CurrentShade) ; 
end; 
end; 

end. 



o 

•£! 
¥> 

m 
a 
m 
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-? 
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\i 

O 
C; 
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unit SplashScreen; 
interface 

^Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ExtCtrls, TMultiP; 

type 

TSplashState = (splCenter, splMoving, splDone) ; 

TfrmSplashScreen = class (TForm) 
U Timerl: TTimer; 

pnlLogo: TPanel; 
•£ Imagel: TImage; 

M. procedure TimerlTimer (Sender : TObject); 
b procedure FormCreate (Sender : TObject); 
Q procedure FormPaint (Sender : TObject); 
\i\ private 

{ Private declarations ) 
SplashState : TSplashState; 
StartPosition : TPoint; 
s \ StartSize : TPoint; 
* VirticalStep : integer; 
y HorizontalStep : integer; 
3 WidthStep : integer; 
!i HeightStep : integer; 
CanPaint : boolean; 
public 

{ Public declarations } 
end; 

var 

f rmSplashScreen : TfrmSplashScreen; 
implementation 
($R * . DFM) 
const 

FinishPosition : TPoint « (x:580; y:700); 

FinishSize : TPoint - (x:430; y:50); 

Duration « 2000; // ms 

Movelnterval •* 50; // ms 

procedure Tf rmSplashScreen . TimerlTimer (Sender : TObject); 
begin 

{ $IFDEF SLIDELOGO) 

if abs( FinishPosition. x - Left) < abs (HorizontalStep) then 

HorizontalStep := HorizontalStep div abs (HorizontalStep) ; 
if abs (FinishPosition .Y - Top) < abs (VirticalStep) then 

VirticalStep := VirticalStep div abs (VirticalStep) ; 

if abs (FinishSize. x - Width) < abs (WidthStep) then 

WidthStep := WidthStep div abs (WidthStep) ; 
if abs (FinishSize. Y - Height) < abs (HeightStep) then 
HeightStep := HeightStep div abs (HeightStep) ; 
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w 

IN 1 



CanPaint := false; 

case SplashState of 
splCenter: 
begin 

Timer 1. Interval := Movelnterval; 
SplashState := splMoving; 

end; 
splMoving: 

be if n (Top = FinishPosition.y) and (Left = FinishPosition x) and 
(Height = FinishSize.y) and (Width = FinishSize.x) then 
SplashState := splDone 
else 
begin 

if Top <> FinishPosition.y then 

Top := Top + VirticalStep; 
if Left <> FinishPosition. x then 

Left := Left + HorizontalStep; 
if Height <> FinishSize.y then 

Height := Height + HeightStep; 
if Width <> FinishSize.x then 

Width := Width + WidthStep; 

end; 
end; 
splDone: 
begin 

Timer 1 .Enabled := false; 
end; 

end; 

CanPaint := true; 
( $ELSE) 

Height := FinishSize.y; 

Width FinishSize.x; 

Top := FinishPosition.y; 

Left := FinishPosition. x; 

pnlLogo.BevelWidth := 2; 
{ $ENDIF} 
end; 

procedure Tf rmSplashScreen . FormCreate (Sender: TObject) ; 
begin 

SplashState := splCenter; 
StartPosition.x := Left; 
StartPosition.y := Top; 
StartSize.x := Width; 

//vXrictrs^p^^rSishPosition.y - StartPosition.y, div (Duration div 

/^orfzon^aistep := (FinishPosition. x - StartPosition.x, div (Duration div 

(FinishSize.y - StartSize.y, div (Duration div Movelnterval, 
'//W^ep*:- (FlnJshsfze?x y - StartSize.x, div (Duration div Movelnterval); 

VirticalStep := 1; 
HorizontalStep :« 1; 
HeightStep := -1; 
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Widths tep := -1; 
CanPaint := true; 
end; 



procedure TfrmSplashScreen.FormPaint (Sender: TObject) 



begin 

if CanPaint then 
Imagel. Repaint; 

end; 



end. 



o 

m 
o 
m 
m 

w 
tp 
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unit ToothObject; 



interface 

uses _ , . 

Windows, SysUtils, Classes, Graphics, 

ShadeData; 
type 

TTooth = class (TObject) 
private 

=, Referencelnitialised : boolean; 

S function CalculateTestArea(Row, Col : integer; 

J ! Area : TRect; 

D NoRows, NoCols : integer) : TRect; 

c=S: 

2! public 

~; Red : real; 

Green : real; 
jf* Blue : real; 

i Hue : real; 

p Saturation : real; 

U Intensity : real; 

J RefRed : real; 

p*i RefGreen : real; 

«I RefBlue : real; 

^ Re f Hue : real; 

RefSaturation : real; 

Reflntensity : real; 

ToothBitmap : TBitmap; 

ToothBitmapMask : TBitmap; 

constructor Create; 

procedure Free; rin 
procedure LoadBitmapFromFile (Filename : String), 
procedure RemoveRef lection (TestArea : TRect); 
procedure RemoveMask (TestArea : TRect); 

function FillSearchSampleLimits(StartPoint : TPoint) : TRect, 
orocedure Analyse (Row, Col : integer; 

proceau /vn y ^ TRect; NoRows, NoCols : integer; 

var R, G, B : real; 
var PixelPercentage : real) ; 
function AnalyseGrid(Area s TRect;NoRows, H°Cols : integer, 

DeltaRed, DeltaGreen, DeltaBlue . real) . 

TShadeColours; . ^ Ul1 _ o-h Tnt • real) ; 

procedure CalculateHSI (R, G, B : real; var Hue, Sat, Int . real), 

end; 



implementation 

uses 

Dialogs, Math; 

const 

RedMask : longint - 5000000FF; 

GreenMask : longint = $OOOOFFOO; 
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BlueMask : longint - $00FF0000; 

Boundrylntensity = 0.58; // sum of RGB 

Reflectionlntensity « 1.86; 

type 

TDirection = (Up, Down, Left, Right) ; 

constructor TTooth . Create; 
begin 

ToothBitmap TBi tmap. Create; 
ToothBitmap. Width := 64 0; 
ToothBitmap. Height := 480; 
ToothBitmapMask :« TBi tmap. Create ; 
ToothBitmapMask. Width :« 640; 
ToothBitmapMask. Height := 480; 
Ref erencelnitialised : = false; 

end; 

procedure TTooth. Free; 
begin 

ToothBitmap . Free ; 

ToothBitmapMask. Free; 

Inherited Free; 
! end; 

' function TTooth.FillSearchSam P leLimits(StartPoint : TPoint) : TRect; 
procedure FillSearch (StartpointX, StartpointY : integer); 
var 

Red, Green, Blue : integer; 
x, y : integer; 
begin 

if StartPointX > Result. Right then 

Result. Right :« StartpointX; ^ 
if StartpointX < Result. Left then 

Result. Left := StartpointX; 
if StartpointY > Result . Bottom then 

Result .Bottom := StartpointY; 
if StartpointY < Result. Top then 

Result. Top :« StartpointY; 

for x :- -1 to 1 do 

for y := -1 to 1 do ^ x 

if (StartpointX+x < 640) and (StartpomtX+x > 0) and 
(StartpointY+y < 480) and (StartpointY+y > 0) and 

(ToothBitmapMask. Canvas. Pixels [StartpointX+x, StartpointY+y] <> 0) 

then 

b6 Red :« ToothBitmap. Canvas. Pixels [StartpointX+x, StartpointY+y] and 
RedMask; ^ (ToothBitmap. Canvas . Pixels [StartpointX+x, StartpointY+y] and 

GreenMask)^shr 8^ (ToothBitmap Canvas m p ixe ls [StartpointX+x, StartpointY+y] and 

BlueMask) shr 16; _ 

if ((Red + Green + Blue)/255) > Boundrylntensity then 

^ToothBitmapMask. Canvas. Pixels [StartpointX+x, StartpointY+y) := 0; 
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FillSearch (StartpointX+x, StartpointY+y ) ; 

end 
end; 

end; 

begin ^ 

Result := Rect(640 / 480, 0, 0); 
FillSearcMStartPoint.X, Start Poxnt . Y) ; 

end; 

function TTooth. CalculateTestArea (Row, Col : integers- 
Area : TRect; 

NoRows, NoCols : integer) : TRect ; 

var 

TestArea : TRect; 
ColSpacing : real; 
RowSpacing : real; 
begin 

with Area do 

begin , « ~ i 

ColSpacing := (Right - Left) / NoCols; 

RowSpacing : = (Bottom - Top) / NoRows; 

TestArea. Top := Top + Trunc (RowSpacing * *° w > ' 

Test Area. Bottom := Top + Trunc (RowSpacing * (Row +1)), 

TestArea. Left := Left + Trunc (ColSpacing Col); 

TestArea. Right := Left + Trunc (ColSpacing (Col + 1) ) , 
end; 

CalculateTestArea := TestArea; 
end; // CalculateTestArea 

procedure TTooth . RemoveRef lection (TestArea : TRect); 
var 

i : integer; 
j : integers- 
Red, Green, Blue : integers- 
begin 

with TestArea do 

for i := Left to Right do 

for j := Top to Bottom do 

^^if (ToothBitMapMask. Canvas. Pixelslisj] <>0) then 
ToothBitMap. Canvas. Pixels [i,j] :~ n 
else 

^lid • = ToothBitMap. Canvas. Pixels [i,j] and RedMask; 

Green • - °ToothBi?Ma P . Canvas. Pixels [i,j] and GreenMask) shr 8; 
Blue := (ToothBitMap Canvas. Pixel. [±,jl and BlueMask) shr 16; 

if ((Red + Green + Blue) / 255 > Ref lectionlntensity) then 
ToothBitMap. Canvas. Pixels [i,j] :~ 0; 

end; 

ends- 
end; // RemoveReflection 

procedure TTooth . RemoveMask (TestArea : TRect); 
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var 

i : integer; 
j : integer; 
begin 

with TestArea do 

for i := Left to Right do 

for j : = Top to Bottom do 

if (ToothBitMapMask. Canvas. Pixels [i,j] <> °) then 
ToothBitMap. Canvas. Pixels [i,j] := 0; 



end; // RemoveRef lection 



orocedure TTooth .Analyse (Row, Col : integer; 

procedure j, ^ T Rect; NoRows, NoCols : integer; 



var R, G, B : real; 
var PixelPercentage : real); 



var 

TestArea : TRect; 
PixelCount : longint; 



i : integer; 

j : integer; 

RedTotal : longint; 

GreenTotal : longint; 

BlueTotal : longint; 

Red, Green, Blue : integer; 

^^TestArea := CalculateTestArea (Row, Col, Area, NoRows, NoCols) ; 

with TestArea do 

PixelCount := (Right - Left + 1) * (Bottom - Top + 1), 

// Now average ignoring reflections and blemishes 
RedTotal := 0; 
GreenTotal := 0; 
BlueTotal := 0; 

with TestArea do 

for i := Left to Right do 

f or j : = Top to Bottom do 

begin 

if ToothBitMap. Canvas. Pixels <> 0 then 

bS Red := ToothBitMap. Canvas. Pixels[i,j] and RedMask; 

Green := (ToothBitMap. Canvas . Pixels [i, j ) and GreenMask) shr 8; 
Blue := (ToothBitMap. Canvas. Pixels[i,j] and BlueMask) shr 16; 

RedTotal :« RedTotal + Red; 

GreenTotal GreenTotal + Green; 

BlueTotal := BlueTotal + Blue; 
end 
else 

begin . . , 

PixelCount PixelCount - 1; // Ignored thxs pixel 

end; 

end; 
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# 



// Normalised RGB 

if PixelCount > 0 then 

begin 

R : = RedTotal / PixelCount / 255; 
G •= GreenTotal / PixelCount / 255; 
B •= BlueTotal / PixelCount / 255; 

Wi 5i«lU«StS.. := PixelCount / ( (Bottom-Top*!) MRight - Loft+IM 

end 
else 
begin 
R : «= 0; 
% G := 0; 

r- B := 0; 

^ ! pixelPercentage := 0; 

end; 

;K j end; // Analyse 

^function TTooth .AnalyseGrid (Area : TRect; 

.tunction nqRows, NoCols : integer; 

« ! DeltaRed, DeltaGreen, DeltaBlue : real) : 

■2 

ri TShadeColour s ; 
\ivar 

Row, Col .: integer; 
p; Red, Green, Blue, PixelPercent : real; 

iSi begin 

; : H Result := TShadeColours. Create; 

for Row := 0 to NoRows - 1 do 
for Col := 0 to NoCols - 1 do 

^Analyse (Row, Col, Area, NoRows, NoCols, 

Analyses , , Blu6/ Pixe lPercent ) ; 

. ^ • ^ rmui Row+11 :» TShadeColourElement . Create; 

Blue + DeltaBlue, 
PixelPercent) ; 

end; 

end; 

^ ^ i !.i. 0 HQTfR G B • real; var Hue, Sat, Int : real) 
procedure TTooth. CalculateHSI (R, t> - «di, 

function Minimum (vl, v2, v3 : real) : real; 
begin 

if (vl <= v2) and (vl <= v3) then 
minimum := vl 

else 

if (v2 <= vl) and (v2 <= v3) then 
Minimum : = v2 
else 

Minimum :« v3; 

end; 

function Maximum (vl, v2, v3 : r al) : real; 
begin 

if (vl >= v2) and (vl >- v3) then 
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Maximum := vl 

6 Is© 

if (v2 >= vl) and (v2 >= v3) then 
Maximum :*= v2 
else 

Maximum :■= v3; 

end; 

be9i // calculation using Gonzalez and Woods 
int := (R + G + B) / 3; 

if Int > 0 then 

begin #h+g+B)) * Minimum (R/ G, B) ; 

HE I: Ucos(((lR-G)5(R-B) ) )/2)/s qr t( Sq r(R-G) + (( R -B)MG-B)),) /(2*px), 

if (B / Int) > (G / Int) then 
Hue := 1 - Hue; 

end 

else 

begin 

Sat := 0; 

Hue := 0; 
end; 

end; // CalculateHSI 

procedure TTooth . LoadBitmapFromFile (Filename : String); 

begin . „ . 

ToothBitmap.LoadFromFile (Filename) ; 

ToothBitmap. Dormant; 

ToothBitmapMask. Assign (ToothBitmap) ; 
end; // LoadBitmapFromFile 



end. 
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